Example 4  -  Make Regular Tetrahedron.{λ7;W100;JAF3}

BEGIN "EXAMPLE FOUR"
	REQUIRE "GEOMES.HDR[GEM,HE]" SOURCE_FILE;	αα GEOMED EMBEDDED IN SAIL;
	DEFINE αα="COMMENT";DEFINE PI="3.1415927";
INTEGER PROCEDURE MKTETRA (REAL R);			αα MAKE TETRAHEDRON;
BEGIN "MKTETRA"
	INTEGER B,F1,F2,V1,V2,V3,V4;
	B ← MKBFV; F1 ← PFACE(B); V1 ← PVT(B);		αα MAKE POINT POLYHDERA;
	XWC(V1) ← ABS(R*0.942809); ZWC(V1) ← -ABS(R/3);	αα POSITION FIRST VERTEX;
	V2 ← MKEV(F1,V1); ROTATE(V2,0,0,2*PI/3);	αα MAKE AND POSITION 2ND VERTEX;
	V3 ← MKEV(F1,V2); ROTATE(V3,0,0,2*PI/3);	αα MAKE AND POSITION 3RD VERTEX;
	V4 ← MKEV(F1,V3);				αα MAKE AND POSITION 4TH VERTEX;
	XWC(V4)←YWC(V4)←0;ZWC(V4)←ABS(R);
	MKFE(V1,F1,V4); F2 ← PFACE(F1);			αα CLOSE SKEW QUADRILATERAL;
	MKFE(V1,F1,V3);	MKFE(V2,F2,V4);
	RETURN(B);					αα RETURN THE CREATION;
END "MKTETRA";
	MKUNIV; MKTETRA(6);				αα INITIALIZE AND TEST MKTETRA;
	GEODPY;						αα DISPLAY REFRESH;
END "EXAMPLE FOUR";{λ30;W0,1260,0,1900;JUFA}

Example 5  -  Glue two N-edged faces together.{λ7;W100;JAF3}

BEGIN "EXAMPLE FIVE"
	REQUIRE "GEOMES.HDR[GEM,HE]" SOURCE_FILE;	αα GEOMED EMBEDDED IN SAIL;
	DEFINE αα="COMMENT"; DEFINE PI="3.1415927";
	INTEGER B1,B2;					αα TWO TEST CUBES;
INTEGER PROCEDURE GLUEFF(INTEGER FACE1,FACE2);		αα DEMO GLUE FACE TO FACE;
BEGIN "GLUEFF"
	INTEGER V,V1,V2,E,E0,I; REAL DMIN,D;
	V1 ← VCCW(PED(FACE1),FACE1);			αα PICK ONE VERTEX OF FACE1;
αα FIND VERTEX OF FACE2 THAT IS CLOSEST TO V1;
	DMIN ← 10@10; E ← E0 ← PED(FACE2);		αα INITIALIZE MINIMAL DISTANCE;
	DO BEGIN
		V ← VCCW(E,FACE2);D ← DISTAN(V1,V);	αα SCAN FACE2 FOR VERTEX CLOSEST TO V1;
		IF Dα<DMIN THEN BEGIN DMIN←D;V2←V;END;
	END UNTIL E0 = (E←ECCW(E,FACE2));
αα MAKE THE WASP EDGE;
	E ← GLUEE(FACE1,V1,FACE2,V2);			αα FACE2 AND BODY ARE KILLED;
αα CLOSE OTHER EDGES;
	V ← OTHER(NCCW(E),V1);				αα LAST VERTEX, TO STOP SCAN;
	DO BEGIN
		V1 ← OTHER(PCW(E),V1);			αα FETCH NEXT PAIR OF VERTICES;
		V2 ← OTHER(PCCW(E),V2);
		E ← MKFE(V1,FACE1,V2);			αα CLOSE AN EDGE;
	END UNTIL V=V1;
	RETURN(BGET(E));				αα RETURN THE SURVIVING BODY;
END "GLUEFF";
	MKUNIV;						αα INITIALIZATION;
	B1 ← MKCUBE(2,2,2); B2 ← MKCUBE(3,3,3);		αα TWO TEST CUBES;
	ROTATE(B1,0,-PI/2,0);TRANSL(B1,-3,0,0);		αα ORIENT CUBES SO FIRST FACES...;
	ROTATE(B2,0,+PI/2,0);TRANSL(B2,+4,0,0);		αα ...ARE OPPOSITE;
	GLUEFF(PFACE(B1),PFACE(B2));			αα TEST THE FUNCTION;
	GEODPY;						αα DISPLAY REFRESH;
END "EXAMPLE FIVE";{λ30;W0,1260,0,1900;JUFA}